home *** CD-ROM | disk | FTP | other *** search
/ By Popular Request 2.0 / By Popular Request 2.0 (Arsenal Computer).ISO / amiga_6 / tikmet12.lha / TickMet.LST < prev   
File List  |  1994-12-10  |  9KB  |  482 lines
  1. versnum$="$VER: TickMet 1.2kyj"
  2. versnum$="1.2"
  3. versdate$="09-Dec-94"
  4. '
  5. MODE 1
  6. esc$=CHR$(27)
  7. de$=CHR$(8)+" "+CHR$(8)
  8. DIM ansi$(10)
  9. '
  10. GOSUB setansi
  11. GOSUB getmetconfig
  12. '
  13. OPEN "O",#1,"*",0
  14. RELSEEK #1,0
  15. '
  16. '
  17. PRINT #1,""
  18. PRINT #1,ansi$(3)+"        ---------"+ansi$(2)+"Tick"+ansi$(0)+" - "+ansi$(2)+"Met"+ansi$(3)+"---------"
  19. PRINT #1,ansi$(0)+"        Vers "+versnum$+"   "+ansi$(3)+"by PD  "+ansi$(0)+versdate$
  20. PRINT #1,""
  21. '
  22. @parsecmd
  23. '
  24. IF abort!=TRUE
  25.   PRINT #1,""
  26.   PRINT #1,ansi$(2)+"ERROR! "+ansi$(3);
  27.   IF blat%=3
  28.     PRINT #1,"Command line missing or truncated."
  29.   ELSE IF blat%=4
  30.     PRINT #1,"Insufficient arguments."
  31.   ENDIF
  32.   PRINT #1,""
  33.   PRINT #1,ansi$(3)+"Usage:    "+ansi$(0)+"TickMet <name> <path> <area> <length> <desc>"
  34.   PRINT #1,""
  35.   PRINT #1,ansi$(3)+"From Tick.cfg: "+ansi$(0)+"EXECUTE "+CHR$(34)+"<path>TickMet %n %p %a %l %d"+CHR$(34)
  36.   RELSEEK #1,0
  37.   GOTO bye
  38. ENDIF
  39. '
  40. '
  41. fname$=iname$
  42. PRINT #1,"        Filename      : "+fname$
  43. RELSEEK #1,0
  44. fpath$=ipath$
  45. PRINT #1,ansi$(0)
  46. PRINT #1,"        Directory     : "+fpath$
  47. RELSEEK #1,0
  48. '
  49. @parseconfig
  50. '
  51. IF abort!=TRUE
  52.   PRINT #1,ansi$(2)+"ERROR! "+ansi$(3);
  53.   IF blat%=1
  54.     PRINT #1,"Udfiles/File.areas not found."
  55.   ELSE IF blat%=2
  56.     PRINT #1,"Number of items in 'file.areas' not a multiple of 5."
  57.   ENDIF
  58.   RELSEEK #1,0
  59.   GOTO skipmetro
  60. ENDIF
  61. '
  62. '
  63. k%=0
  64. WHILE k%<numareas%
  65.   INC k%
  66.   IF cfg$(1,k%)=ipath$
  67.     selkey$=cfg$(0,k%)
  68.   ENDIF
  69.   EXIT IF cfg$(1,k%)=ipath$
  70. WEND
  71. '
  72. IF selkey$=""
  73.   PRINT #1,""
  74.   PRINT #1,ansi$(2)+"ERROR! "+ansi$(3)+"No area found for this file."
  75.   RELSEEK #1,0
  76.   GOTO bye
  77. ENDIF
  78. '
  79. xx$=ufd$+"udfiles/FileList_"+selkey$
  80. IF EXIST(xx$)
  81.   OPEN "I",#2,xx$,204
  82.   topfile%=LOF(#2)/204
  83.   CLOSE #2
  84. ELSE
  85.   topfile%=0
  86. ENDIF
  87. '
  88. fbyte$=ibyte$
  89. PRINT #1,"        File Size     : "+fbyte$
  90. PRINT #1,"        File Number   : "+STR$(topfile%+1)
  91. GOSUB dateconv(DATE$)
  92. fdate$=pd.date$
  93. PRINT #1,"        Date Sent     : "+fdate$
  94. fsent$=isent$
  95. PRINT #1,"        Uploader      : "+fsent$
  96. RELSEEK #1,0
  97. '
  98. OPEN "I",#2,sfd$+"BBSFILES/index"
  99. LINE INPUT #2,xx$
  100. CLOSE #2
  101. findx$=xx$
  102. PRINT #1,"        Index Number  : "+findx$
  103. '
  104. fdesc$=idesc$
  105. PRINT #1,"        Description   : "+LEFT$(idesc$,45)+"..."
  106. PRINT #1,""
  107. RELSEEK #1,0
  108. '
  109. IF topfile%>495
  110.   PRINT #1,""
  111.   PRINT #1,ansi$(2)+"ERROR! "+ansi$(3)+"Over 495 files already in this area!"
  112.   RELSEEK #1,0
  113.   GOTO skipmetro
  114. ENDIF
  115. '
  116. '
  117. ' Get rid of the < signs which were causing file redirection probs in GFA
  118. '
  119. kly%=INSTR(fdesc$,"<")
  120. WHILE kly%<>0
  121.   ttt$=LEFT$(fdesc$,kly%-1)
  122.   ttt$=ttt$+"("+MID$(fdesc$,kly%+1,100)
  123.   fdesc$=ttt$
  124.   kly%=INSTR(fdesc$,"<")
  125. WEND
  126. '
  127. ' Here's where we actually DO add the file into the listing..
  128. '
  129. @udfileprep
  130. @udfileput(topfile%+1)
  131. CLOSE #3
  132. '
  133. ' find the HiFile number..
  134. '
  135. IF EXIST(sfd$+"BBSFILES/hifile")
  136.   OPEN "I",#2,sfd$+"BBSFILES/hifile",20
  137.   LINE INPUT #2,hifile$
  138.   CLOSE #2
  139. ELSE
  140.   hifile$="0"
  141. ENDIF
  142. '
  143. ' and set the (useless) hdf X file - huh!  Not any more!
  144. '
  145. ' Increment the HiFile number..
  146. '
  147. OPEN "O",#2,sfd$+"BBSFILES/hifile",20
  148. PRINT #2,VAL(hifile$)+1
  149. CLOSE #2
  150. '
  151. PRINT #1,ansi$(0)+"        * Added file to Metro area succesfully."
  152. RELSEEK #1,0
  153. '
  154. '
  155. skipmetro:
  156. '
  157. IF EXIST("MAIL:TickMet.cfg")
  158.   OPEN "I",#2,"MAIL:TickMet.cfg",64
  159.   LINE INPUT #2,entries$
  160.   LINE INPUT #2,fileout$
  161.   CLOSE #2
  162.   '
  163.   entries%=VAL(entries$)
  164.   IF (entries%>500) OR (entries%<1)
  165.     GOTO bye
  166.   ENDIF
  167.   '
  168.   PRINT #1,"        * Writing to 'Last "+entries$+" Files' list...";
  169.   '
  170.   IF NOT EXIST(fileout$)
  171.     OPEN "O",#2,fileout$,4096
  172.     PRINT #2,"----"
  173.     PRINT #2,"File: ";fname$
  174.     PRINT #2,"Size: ";fbyte$
  175.     PRINT #2,"Date: ";fdate$
  176.     PRINT #2,"Area: ";fsent$
  177.     PRINT #2,"Desc: ";LEFT$(fdesc$,72)
  178.     '
  179.     CLOSE #2
  180.     '
  181.   ELSE
  182.     '
  183.     DIM lastline$(entries%)
  184.     DIM lastfile$(entries%)
  185.     DIM lastsize$(entries%)
  186.     DIM lastdate$(entries%)
  187.     DIM lastarea$(entries%)
  188.     DIM lastdesc$(entries%)
  189.     '
  190.     OPEN "I",#2,fileout$,4096
  191.     '
  192.     count%=0
  193.     '
  194.     WHILE NOT EOF(#2)
  195.       INC count%
  196.       LINE INPUT #2,lastline$(count%)
  197.       EXIT IF EOF(#2)
  198.       LINE INPUT #2,lastfile$(count%)
  199.       EXIT IF EOF(#2)
  200.       LINE INPUT #2,lastsize$(count%)
  201.       EXIT IF EOF(#2)
  202.       LINE INPUT #2,lastdate$(count%)
  203.       EXIT IF EOF(#2)
  204.       LINE INPUT #2,lastarea$(count%)
  205.       EXIT IF EOF(#2)
  206.       LINE INPUT #2,lastdesc$(count%)
  207.       EXIT IF EOF(#2)
  208.       '
  209.       EXIT IF count%>=entries%
  210.       '
  211.     WEND
  212.     CLOSE #2
  213.     '
  214.     INSERT lastline$(1)="----"
  215.     INSERT lastfile$(1)="File: "+fname$
  216.     INSERT lastsize$(1)="Size: "+fbyte$
  217.     INSERT lastdate$(1)="Date: "+fdate$
  218.     INSERT lastarea$(1)="Area: "+fsent$
  219.     INSERT lastdesc$(1)="Desc: "+LEFT$(fdesc$,72)
  220.     '
  221.     OPEN "O",#2,fileout$,4096
  222.     '
  223.     FOR k%=1 TO entries%
  224.       PRINT #2,lastline$(k%)
  225.       PRINT #2,lastfile$(k%)
  226.       PRINT #2,lastsize$(k%)
  227.       PRINT #2,lastdate$(k%)
  228.       PRINT #2,lastarea$(k%)
  229.       PRINT #2,lastdesc$(k%)
  230.     NEXT k%
  231.     CLOSE #2
  232.     '
  233.   ENDIF
  234.   '
  235.   PRINT #1,"...done!"
  236.   RELSEEK #1,0
  237.   '
  238. ENDIF
  239. '
  240. '
  241. '
  242. bye:
  243. PRINT #1,ansi$(0);
  244. CLOSE #1
  245. END
  246. '
  247. '
  248. '
  249. '
  250. '
  251. '
  252. PROCEDURE parsecmd
  253.   '
  254.   LOCAL k%
  255.   '
  256.   abort!=FALSE
  257.   aa$=TRIM$(_dosCmd$)
  258.   IF LEN(aa$)<5
  259.     abort!=TRUE
  260.     blat%=3
  261.     GOTO parsecmdexit
  262.   ENDIF
  263.   '
  264.   spc%=0
  265.   FOR k%=1 TO LEN(aa$)
  266.     IF MID$(aa$,k%,1)=" "
  267.       INC spc%
  268.     ENDIF
  269.   NEXT k%
  270.   '
  271.   IF spc%<4
  272.     abort!=TRUE
  273.     blat%=4
  274.     GOTO parsecmdexit
  275.   ENDIF
  276.   '
  277.   xx%=INSTR(aa$," ")
  278.   iname$=TRIM$(UPPER$(LEFT$(aa$,xx%)))
  279.   aa$=RIGHT$(aa$,LEN(aa$)-xx%)
  280.   aa$=TRIM$(aa$)
  281.   '
  282.   xx%=INSTR(aa$," ")
  283.   ipath$=TRIM$(UPPER$(LEFT$(aa$,xx%)))
  284.   IF RIGHT$(ipath$,1)<>"/"
  285.     ipath$=ipath$+"/"
  286.   ENDIF
  287.   aa$=RIGHT$(aa$,LEN(aa$)-xx%)
  288.   aa$=TRIM$(aa$)
  289.   '
  290.   xx%=INSTR(aa$," ")
  291.   isent$=UPPER$(LEFT$(aa$,xx%))
  292.   aa$=RIGHT$(aa$,LEN(aa$)-xx%)
  293.   aa$=TRIM$(aa$)
  294.   '
  295.   xx%=INSTR(aa$," ")
  296.   ibyte$=LEFT$(aa$,xx%)
  297.   aa$=RIGHT$(aa$,LEN(aa$)-xx%)
  298.   '
  299.   idesc$=TRIM$(aa$)
  300.   IF ASC(RIGHT$(idesc$,1))<31
  301.     idesc$=LEFT$(idesc$,LEN(idesc$)-1)
  302.   ENDIF
  303.   '
  304.   parsecmdexit:
  305.   '
  306. RETURN
  307. '
  308. PROCEDURE parseconfig
  309.   abort!=FALSE
  310.   IF NOT EXIST(ufd$+"Udfiles/file.areas")
  311.     abort!=TRUE
  312.     blat%=1
  313.     GOTO parseconfigexit
  314.   ENDIF
  315.   '
  316.   lncount%=0
  317.   OPEN "I",#2,ufd$+"Udfiles/file.areas",4096
  318.   WHILE NOT EOF(#2)
  319.     LINE INPUT #2,xxx$
  320.     INC lncount%
  321.   WEND
  322.   CLOSE #2
  323.   '
  324.   xx=lncount%/5
  325.   '
  326.   IF xx<>INT(lncount%/5)
  327.     abort!=TRUE
  328.     blat%=2
  329.     GOTO parseconfigexit
  330.   ENDIF
  331.   '
  332.   numareas%=lncount%/5
  333.   xx%=0
  334.   DIM cfg$(1,numareas%)
  335.   OPEN "I",#2,ufd$+"Udfiles/file.areas",4096
  336.   WHILE NOT EOF(#2)
  337.     INC xx%
  338.     LINE INPUT #2,garb$
  339.     LINE INPUT #2,garb$
  340.     LINE INPUT #2,cfg$(0,xx%)
  341.     ' /\ The keypress
  342.     LINE INPUT #2,garb$
  343.     LINE INPUT #2,cfg$(1,xx%)
  344.     ' /\ The directory name
  345.     '
  346.     cfg$(0,xx%)=TRIM$(UPPER$(cfg$(0,xx%)))
  347.     cfg$(1,xx%)=TRIM$(UPPER$(cfg$(1,xx%)))
  348.     IF RIGHT$(cfg$(1,xx%),1)<>":"
  349.       IF RIGHT$(cfg$(1,xx%),1)<>"/"
  350.         cfg$(1,xx%)=cfg$(1,xx%)+"/"
  351.       ENDIF
  352.     ENDIF
  353.   WEND
  354.   CLOSE #2
  355.   '
  356.   parseconfigexit:
  357.   '
  358. RETURN
  359. '
  360. '
  361. '
  362. '
  363. PROCEDURE udfileprep
  364.   OPEN "R",#3,ufd$+"udfiles/FileList_"+selkey$,204
  365.   FIELD #3,11 AS fin$,25 AS ffn$,76 AS fds$,7 AS fby$,10 AS fda$,25 AS fsb$,50 AS fpa$
  366. RETURN
  367. '
  368. '
  369. PROCEDURE udfileput(uu%)
  370.   LSET fin$=findx$
  371.   LSET ffn$=fname$
  372.   LSET fds$=fdesc$
  373.   LSET fby$=fbyte$
  374.   LSET fda$=fdate$
  375.   LSET fsb$=fsent$
  376.   LSET fpa$=fpath$
  377.   PUT #3,uu%
  378. RETURN
  379. '
  380. PROCEDURE setansi
  381.   '
  382.   ansi$(1)=esc$+"[31m"
  383.   ansi$(2)=esc$+"[32m"
  384.   ansi$(3)=esc$+"[33m"
  385.   ansi$(4)=esc$+"[34m"
  386.   ansi$(0)=esc$+"[0m"
  387. RETURN
  388. '
  389. PROCEDURE dateconv(pddt$)
  390.   '
  391.   ' converts date to Fido style DD-Mmm-YY
  392.   ' string to use is pd.date$
  393.   '
  394.   LOCAL pd.temp$,pd.date1$,pd.date2$,pd.date3$,pd.month%,pd.month$
  395.   '
  396.   ' (Only thing this returns is the pd.date$)
  397.   '
  398.   pd.date1$=LEFT$(pddt$,2)
  399.   pd.date2$=MID$(pddt$,4,2)
  400.   pd.date3$=RIGHT$(pddt$,2)
  401.   pd.month%=VAL(pddt$)
  402.   '
  403.   SELECT pd.month%
  404.     '
  405.   CASE 1
  406.     pd.month$="Jan"
  407.   CASE 2
  408.     pd.month$="Feb"
  409.   CASE 3
  410.     pd.month$="Mar"
  411.   CASE 4
  412.     pd.month$="Apr"
  413.   CASE 5
  414.     pd.month$="May"
  415.   CASE 6
  416.     pd.month$="Jun"
  417.   CASE 7
  418.     pd.month$="Jul"
  419.   CASE 8
  420.     pd.month$="Aug"
  421.   CASE 9
  422.     pd.month$="Sep"
  423.   CASE 10
  424.     pd.month$="Oct"
  425.   CASE 11
  426.     pd.month$="Nov"
  427.   CASE 12
  428.     pd.month$="Dec"
  429.   DEFAULT
  430.     pd.month$="???"
  431.   ENDSELECT
  432.   pd.date$=pd.date2$+"-"+pd.month$+"-"+pd.date3$
  433.   '
  434. RETURN
  435. '
  436. '
  437. PROCEDURE getmetconfig
  438.   '
  439.   IF EXIST("S:Metro.cfg")
  440.     config$="S:Metro.cfg"
  441.   ELSE IF EXIST("BBS:Metro.cfg")
  442.     config$="BBS:Metro.cfg"
  443.   ELSE IF EXIST("Metro.cfg")
  444.     config$="Metro.cfg"
  445.   ELSE
  446.     config$="XXX"
  447.   ENDIF
  448.   '
  449.   ' Defaults
  450.   '
  451.   sfd$="BBS:"
  452.   ufd$="BBS:"
  453.   IF config$<>"XXX"
  454.     '
  455.     OPEN "I",#2,config$,128
  456.     DO WHILE (NOT EOF(#2))
  457.       LINE INPUT #2,xx$
  458.       xx$=TRIM$(xx$)
  459.       xxu$=UPPER$(xx$)
  460.       '
  461.       IF xxu$="" OR LEFT$(xxu$,1)=";"
  462.         ' Do nothing
  463.       ELSE IF LEFT$(xxu$,8)="FILEPATH"
  464.         xx$=MID$(xx$,9,255)
  465.         xx$=TRIM$(xx$)
  466.         IF RIGHT$(xx$,1)<>"/" AND RIGHT$(xx$,1)<>":"
  467.           xx$=xx$+"/"
  468.         ENDIF
  469.         ufd$=xx$
  470.       ENDIF
  471.       '
  472.     LOOP UNTIL EOF(#2)
  473.     CLOSE #2
  474.   ELSE
  475.     END
  476.   ENDIF
  477.   '
  478.   '
  479. RETURN
  480. '
  481. '
  482.